home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / qbfaqr01.zip / 3D.BAS next >
BASIC Source File  |  1992-08-10  |  14KB  |  405 lines
  1. 'Well, here you go! This is an improved, easier to read version of my
  2. 'fast 3-D wireframe program. I've done some things that a couple
  3. 'people recommended and I've also sped it up a little.
  4. '(The number at the upper left corner of the screen is the number of frames
  5. 'per second that are being displayed. It's updated every 20 frames, so
  6. 'it will be a little choppy.)
  7.  
  8.  
  9. '3DEXP1a.BAS By Rich Geldreich April 16th, 1992
  10. '(This version has some documentation...)
  11.  
  12. DEFINT A-Z
  13. TYPE LineType
  14.     X AS INTEGER
  15.     Y AS INTEGER
  16.     Z AS INTEGER
  17.     X1 AS INTEGER
  18.     Y1 AS INTEGER
  19.     Z1 AS INTEGER
  20. END TYPE
  21. DIM Points(100) AS LineType
  22. DIM Xs(100), Ys(100), Xe(100), Ye(100), Xn(100), Yn(100)
  23. DIM Xs1(100), Ys1(100), Xe1(100), Ye1(100)
  24. DIM X(100), Y(100), Z(100), Pointers1(100), Pointers2(100)
  25. DIM R(100)
  26. DIM Cosine&(360), Sine&(360)
  27. CLS
  28. PRINT "3-D Craft"
  29. PRINT "By Rich Geldreich 1992"
  30. PRINT
  31. PRINT "Keys to use: (Turn NUMLOCK on!)"
  32. PRINT "Q...............Quits"
  33. PRINT "Numeric keypad..Controls your position(press 5 on the keypad"
  34. PRINT "                to completly stop yourself) "
  35. PRINT "-...............Forward exceleration"
  36. PRINT "+...............Backward exceleration"
  37. PRINT "Arrow keys......Controls the rotation of the craft"
  38. PRINT "F...............Excelerates the craft (Forward)"
  39. PRINT "B...............Slows the craft (Backward)"
  40. PRINT "S...............Stops the craft"
  41. PRINT "A...............Toggles Auto Center, use this when you lose";
  42. PRINT " the craft"
  43. PRINT "C...............Stops the craft's rotation"
  44. PRINT "V...............Resets the craft to starting position"
  45. PRINT
  46. PRINT "Wait a sec..."
  47.  
  48. 'The following for/next loop makes a sine & cosine table.
  49. 'Each sine & cosine is multiplied by 1024 and stored as long integers.
  50. 'This is done so that we don't have to use any slow floating point
  51. 'math at run time.
  52. a = 0
  53. FOR a! = 0 TO 359 / 57.29577951# STEP 1 / 57.29577951#
  54.     Cosine&(a) = INT(.5 + COS(a!) * 1024)
  55.     Sine&(a) = INT(.5 + SIN(a!) * 1024): a = a + 1
  56. NEXT
  57. 'Next we read in all of the lines that are in the object...
  58. FOR a = 0 TO 44
  59.     READ Points(a).X, Points(a).Y, Points(a).Z
  60.     READ Points(a).X1, Points(a).Y1, Points(a).Z1
  61. NEXT
  62. 'Here comes the hard part... Consider this scenario:
  63.  
  64. 'We have two connected lines, like this:
  65.  
  66. '   1--------2 and 3
  67. '            |
  68. '            |
  69. '            |
  70. '            |
  71. '            4
  72. 'Where 1,2, 3, & 4 are the starting and ending points of each line.
  73. 'The first line consists of points 1 & 2  and the second line
  74. 'is made of points 3 & 4.
  75. 'So, you ask, what's wrong? Nothing, really, but don't you see that
  76. 'points 2 and 3 are really at the sample place? Why rotate them twice,
  77. 'that would be a total waste of time? The following code eliminates such
  78. 'occurrences from the line table. (great explanation, huh?)
  79.  
  80. NumberLines = 45
  81. 'take all of the starting & ending points and put them in one big
  82. 'array...
  83. Np = 0
  84. FOR a = 0 TO NumberLines - 1
  85.     X(Np) = Points(a).X
  86.     Y(Np) = Points(a).Y
  87.     Z(Np) = Points(a).Z
  88.     Np = Np + 1
  89.     X(Np) = Points(a).X1
  90.     Y(Np) = Points(a).Y1
  91.     Z(Np) = Points(a).Z1
  92.     Np = Np + 1
  93. NEXT
  94. 'Now set up two sets of pointers that point to each point that a line
  95. 'is made of... (in other words, scan for the first occurrence of each
  96. 'starting and ending point in the point array we just built...)
  97. FOR a = 0 TO NumberLines - 1
  98.     Xs = Points(a).X
  99.     Ys = Points(a).Y
  100.     Zs = Points(a).Z            'get the 3 coordinates of the start point
  101.     FOR B = 0 TO Np - 1         'scan the point array
  102.         IF X(B) = Xs AND Y(B) = Ys AND Z(B) = Zs THEN
  103.             Pointers1(a) = B    'set the pointer to point to the
  104.             EXIT FOR            'point we have just found
  105.         END IF
  106.     NEXT
  107.     Xs = Points(a).X1           'do the same thing that we did above
  108.     Ys = Points(a).Y1           'except scan for the ending point
  109.     Zs = Points(a).Z1           'of each line
  110.     FOR B = 0 TO Np - 1
  111.         IF X(B) = Xs AND Y(B) = Ys AND Z(B) = Zs THEN
  112.             Pointers2(a) = B
  113.             EXIT FOR
  114.         END IF
  115.     NEXT
  116. NEXT
  117. 'Okay, were almost done! All we have to do now is to build a table
  118. 'that tells us which points to actually rotate...
  119. Nr = 0
  120. FOR a = 0 TO NumberLines - 1
  121.     F1 = Pointers1(a)   'get staring & ending point number
  122.     S1 = Pointers2(a)
  123.     IF Nr = 0 THEN      'if this is the first point then it of course
  124.                         'has to be rotated
  125.         R(Nr) = F1: Nr = Nr + 1
  126.     ELSE
  127.         found = 0       'scan to see if this point already exists...
  128.         FOR B = 0 TO Nr - 1
  129.             IF R(B) = F1 THEN
  130.                 found = -1: EXIT FOR    'shoot, it's already here!
  131.             END IF
  132.         NEXT
  133.         IF NOT found THEN R(Nr) = F1: Nr = Nr + 1   'point the point
  134.                                                     'in the array it we
  135.     END IF                                          'can't find it...
  136.  
  137.     found = 0   'now look for the ending point
  138.     FOR B = 0 TO Nr - 1
  139.         IF R(B) = S1 THEN
  140.             found = -1: EXIT FOR
  141.         END IF
  142.     NEXT
  143.     IF NOT found THEN R(Nr) = S1: Nr = Nr + 1
  144. NEXT
  145. PRINT "Press any key to begin..."
  146. a$ = INPUT$(1)
  147. 'The following sets up the rotation & perspective variables.
  148.  
  149. 'Vs = the screen that is currently being viewed
  150. 'Ws = the screen that is currently being worked on
  151. Vs = 1: Ws = 0
  152.  
  153. 'Deg1 & Deg2 are the two angles of rotation
  154. 'D1 & D2 are the deltas of each axes. If D1 = -5, for instance, then
  155. 'Deg1 will be decreased 5 degress every frame.
  156. Deg1 = 0: Deg2 = 0: D1 = 0: D2 = 0
  157.  
  158. 'Spos & Mypos are for the perspective routines...
  159. 'Spos is the screen's Z coordinate and Mypos is the users Z coordinate
  160. Spos = -250: Mypos = 0
  161.  
  162. 'Mx, My, and Mz are the coordinates of the user.
  163. 'Ox, Oy, and Oz are the coordinates of the craft.
  164. Mx = 0: my = 0: Mz = 0: Ox = 0: Oy = 0: Oz = -260
  165. 'main loop
  166. NumberOfFrames = 0
  167. DEF SEG = &H40
  168. StartTime = PEEK(&H6C)
  169. DO
  170.  
  171.     'swap the viewing and working screens for page flipping...
  172.     SWAP Vs, Ws
  173.     SCREEN 9, , Ws, Vs
  174.  
  175.     'adjust the angles according to their deltas...
  176.     Deg1 = (Deg1 + D1) MOD 360
  177.     Deg2 = (Deg2 + D2) MOD 360
  178.     'fix the angles up if they go out of range
  179.     IF Deg1 < 0 THEN Deg1 = Deg1 + 360
  180.     IF Deg2 < 0 THEN Deg2 = Deg2 + 360
  181.     'get the sine and cosine of each angle from the tables
  182.     'that were prepared at the beginning of the program
  183.     C1& = Cosine&(Deg1): S1& = Sine&(Deg1)
  184.     C2& = Cosine&(Deg2): S2& = Sine&(Deg2)
  185.  
  186.     'now we must adjust the object's coordinates
  187.     'based on how quickly it is moving...
  188.  
  189.     X = Speed: Y = 0: Z = 0
  190.  
  191.     X1 = (X * C1&) \ 1024: Y1 = (X * S1&) \ 1024
  192.     X2 = (X1 * C2&) \ 1024: Zn = (X1 * S2&) \ 1024
  193.     Ox = Ox + X2: Oy = Oy + Y1: Oz = Oz + Zn
  194.     IF Oz > 32000 THEN Oz = 32000
  195.     IF Oz < -32000 THEN Oz = -32000
  196.     IF Ox > 32000 THEN Ox = 32000
  197.     IF Ox < -32000 THEN Ox = -32000
  198.     IF Oy > 32000 THEN Oy = 32000
  199.     IF Oy < -32000 THEN Oy = -32000
  200.  
  201.     'if Atloc is true then Auto-Center is on...
  202.     IF Atloc THEN
  203.         Mx = Mx + (Ox - Mx) \ 4
  204.         my = my + (Oy - my) \ 4
  205.         Mz = Mz + ((Oz + 200) - Mz) \ 4
  206.     ELSE
  207.         'adjust the users position based on how much he is moving...
  208.         Mz = Mz + Mzm: Mx = Mx + Mxm: my = my + Mym
  209.         IF Mz > 32000 THEN Mz = 32000
  210.         IF Mz < -32000 THEN Mz = -32000
  211.         IF Mx > 32000 THEN Mx = 32000
  212.         IF Mx < -32000 THEN Mx = -32000
  213.         IF my > 32000 THEN my = 32000
  214.         IF my < -32000 THEN my = -32000
  215.     END IF
  216.     '(Wait for vertical retrace, reduces flicker. This was recommended
  217.     'by someone on the echo but I can't remember who! Thanks)
  218.     WAIT &H3DA, 8
  219.     'erase the old lines...
  220.     IF Ws = 1 THEN
  221.         FOR a = 0 TO Ln(Ws) - 1
  222.             LINE (Xs1(a), Ys1(a))-(Xe1(a), Ye1(a)), 0
  223.         NEXT
  224.     ELSE
  225.         FOR a = 0 TO Ln(Ws) - 1
  226.             LINE (Xs(a), Ys(a))-(Xe(a), Ye(a)), 0
  227.         NEXT
  228.     END IF
  229.     'print frames per second
  230.     LOCATE 1, 1: PRINT a$
  231.     'rotate the points...
  232.     FOR a = 0 TO Nr - 1
  233.         R = R(a): Xo = X(R): Yo = Y(R): Zo = Z(R)
  234.         X1 = (Xo * C1& - Yo * S1&) \ 1024
  235.         Y1& = (Xo * S1& + Yo * C1&) \ 1024 - my + Oy
  236.         X1& = (X1 * C2& - Zo * S2&) \ 1024 - Mx + Ox
  237.         Zn = (X1 * S2& + Zo * C2&) \ 1024 - Mz + Oz
  238.         'if the point is too close(or behind) the viewer then
  239.         'don't draw it...
  240.         IF (Mypos - Zn) < 15 THEN
  241.             Xn(R) = -1: Yn(R) = 0: Zn = 0
  242.         ELSE
  243.             'Put the point into perspective...
  244.             'The original formula was:
  245.             'Xnew=Xnew+( -Xold * ( (Spos-Z) / (MPos-Z) ) )
  246.             'Ynew=Ynew=( -Yold * ( (Spos-Z) / (Mpos-Z) ) )
  247.             v = (1330& * (Spos - Zn)) \ (Mypos - Zn)
  248.             Xn(R) = 320 + X1& + (-X1& * v) \ 1330
  249.  
  250.             'The Y coordinate is also multiplied by .8 to adjust
  251.             'for SCREEN 9's height to width ratio...
  252.  
  253.             Yn(R) = 175 + (8 * (Y1& + (-Y1& * v) \ 1330)) \ 10
  254.         END IF
  255.     NEXT
  256.     'draw the lines...
  257.     '(There are two seperate cases, each puts it's coordinates
  258.     'in a different array for later erasing. I could of used a
  259.     '2 dimensional array for this but that is slower.)
  260.     IF Ws = 1 THEN
  261.         Ln = 0
  262.         FOR a = 0 TO NumberLines - 1
  263.             F1 = Pointers1(a): S1 = Pointers2(a)
  264.             Xn = Xn(F1): Yn = Yn(F1)
  265.             'if Xn<>-1 then it's in view...
  266.             IF Xn <> -1 THEN
  267.                 IF Xn(S1) <> -1 THEN
  268.                     X1 = Xn(S1): Y1 = Yn(S1)
  269.                     LINE (X1, Y1)-(Xn, Yn), 14
  270.                     'store the lines so they can be erased later...
  271.                     Xs1(Ln) = X1: Ys1(Ln) = Y1
  272.                     Xe1(Ln) = Xn: Ye1(Ln) = Yn
  273.                     Ln = Ln + 1
  274.                 END IF
  275.             END IF
  276.         NEXT
  277.     ELSE
  278.         Ln = 0
  279.         FOR a = 0 TO NumberLines - 1
  280.             F1 = Pointers1(a): S1 = Pointers2(a)
  281.             Xn = Xn(F1): Yn = Yn(F1)
  282.             'if Xn<>-1 then it's in view...
  283.             IF Xn <> -1 THEN
  284.                 IF Xn(S1) <> -1 THEN
  285.                     X1 = Xn(S1): Y1 = Yn(S1)
  286.                     LINE (X1, Y1)-(Xn, Yn), 14
  287.                     'store the lines so they can be erased later...
  288.                     Xs(Ln) = X1: Ys(Ln) = Y1
  289.                     Xe(Ln) = Xn: Ye(Ln) = Yn
  290.                     Ln = Ln + 1
  291.                 END IF
  292.             END IF
  293.         NEXT
  294.     END IF
  295.     Ln(Ws) = Ln
  296.     K$ = UCASE$(INKEY$)
  297.     'Process the keystroke(if any)...
  298.     IF K$ <> "" THEN
  299.         SELECT CASE K$
  300.             CASE "A"
  301.                 Atloc = NOT Atloc
  302.             CASE "+"
  303.                 Mzm = Mzm + 2
  304.             CASE "-"
  305.                 Mzm = Mzm - 2
  306.             CASE "5"
  307.                 Mxm = 0: Mym = 0: Mzm = 0
  308.             CASE "4"
  309.                 Mxm = Mxm - 2
  310.             CASE "6"
  311.                 Mxm = Mxm + 2
  312.             CASE "8"
  313.                 Mym = Mym - 2
  314.             CASE "2"
  315.                 Mym = Mym + 2
  316.             CASE "F"
  317.                 Speed = Speed + 5
  318.             CASE "B"
  319.                 Speed = Speed - 5
  320.             CASE "C"
  321.                 D1 = 0: D2 = 0
  322.             CASE "S"
  323.                 Speed = 0
  324.             CASE CHR$(0) + CHR$(72)
  325.                 D1 = D1 + 1
  326.             CASE CHR$(0) + CHR$(80)
  327.                 D1 = D1 - 1
  328.             CASE CHR$(0) + CHR$(75)
  329.                 D2 = D2 - 1
  330.             CASE CHR$(0) + CHR$(77)
  331.                 D2 = D2 + 1
  332.             CASE "Q"
  333.                 SCREEN 0, , 0, 0: CLS : PRINT "See ya later!"
  334.                 END
  335.             CASE "V"
  336.                 D1 = 0: D2 = 0: Deg1 = 0: Deg2 = 0: Speed = 0
  337.         END SELECT
  338.     END IF
  339.     NumberOfFrames = NumberOfFrames + 1
  340.     SOUND 32767, .1
  341.     'see if 20 frames have passed; if so then see
  342.     'how long it took...
  343.     IF NumberOfFrames = 20 THEN
  344.         TotalTime = PEEK(&H6C) - StartTime
  345.         IF TotalTime < 0 THEN TotalTime = TotalTime + 256
  346.         FramesPerSecX100 = 36400 \ TotalTime
  347.         High = FramesPerSecX100 \ 100
  348.         Low = FramesPerSecX100 - High
  349.         'A$ has the string that is printed at the upper left
  350.         'corner of the screen
  351.         a$ = MID$(STR$(High), 2) + "."
  352.         a$ = a$ + RIGHT$("0" + MID$(STR$(Low), 2), 2) + "  "
  353.         NumberOfFrames = 0
  354.         StartTime = PEEK(&H6C)
  355.     END IF
  356. LOOP
  357. 'The following data is the shuttle craft...
  358. 'stored as Start X,Y,Z & End X,Y,Z
  359. DATA -157,22,39,-157,-18,39
  360. DATA -157,-18,39,-127,-38,39
  361. DATA -127,-38,39,113,-38,39
  362. DATA 113,-38,39,193,12,39
  363. DATA 33,42,39,33,42,-56
  364. DATA 33,42,-56,-127,42,-56
  365. DATA -127,42,-56,-157,22,-56
  366. DATA -157,22,-56,-157,22,39
  367. DATA -157,22,-56,-157,-18,-56
  368. DATA -157,-18,-56,-157,-18,39
  369. DATA -157,-18,-56,-127,-38,-56
  370. DATA -127,-38,-56,-127,-38,39
  371. DATA -127,-38,-56,113,-38,-56
  372. DATA 113,-38,-56,113,-38,39
  373. DATA 113,-38,-56,193,12,-56
  374. DATA 193,12,-56,193,12,39
  375. DATA -157,22,-56,193,12,-56
  376. DATA 193,12,39,-157,22,39
  377. DATA -56,-13,41,-56,-3,41
  378. DATA -56,-3,41,-26,-3,41
  379. DATA -26,-3,41,-26,7,41
  380. DATA -51,7,41,-31,-13,41
  381. DATA -11,-13,41,-11,-3,41
  382. DATA -11,-3,41,-1,7,41
  383. DATA 9,7,41,9,-8,41
  384. DATA 9,-8,41,24,-8,41
  385. DATA 34,16,41,34,-38,41
  386. DATA 33,-39,41,33,-39,-53
  387. DATA 33,-39,-53,33,15,-53
  388. DATA -42,-38,19,-72,-38,19
  389. DATA -72,-38,19,-72,-38,-41
  390. DATA -72,-38,-41,-42,-38,-41
  391. DATA -42,-38,-41,-42,-38,19
  392. DATA 33,42,39,34,16,41
  393. DATA 33,42,-56,33,15,-53
  394. DATA -157,22,39,-127,42,39
  395. DATA -127,42,-56,-127,42,39
  396. DATA -127,42,39,33,42,39
  397. DATA 159,-8,-56,159,-8,40
  398. DATA 143,-18,-56,143,-18,39
  399. DATA 193,12,39,193,32,30
  400. DATA 33,42,39,193,32,30
  401. DATA 193,32,30,193,32,-47
  402. DATA 33,42,-56,193,32,-47
  403. DATA 193,12,-56,193,32,-47
  404.  
  405.